home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS in a Box 7
/
BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso
/
Files
/
Bus
/
T-Z
/
TimeCalc.cpt
/
Time Calc
/
TimeCalc.srce
< prev
Wrap
Text File
|
1990-03-02
|
8KB
|
369 lines
{TimeCalc by Gre7g Luterman, Ballistic Grapeware}
{provisions: you may change my code (not comments), but I retain}
{first credits, and postcards come to me. you may add to my}
{code, but you may not sell it or what it becomes without my}
{blessings in writing}
program timecalc;
const
maxhist = 50;
var
thedialog: dialogptr;
dstorage: dialogrecord;
list: listhandle;
listrect: rect;
state: (first, add, sub, eq);
editing: (ehour, emin, esec);
current: record
total: longint;
hour, min, sec: integer;
negative: boolean;
end;
memory: longint;
procedure drawlist (dialog: dialogptr; item: integer);
var
thergn: rgnhandle;
therect: rect;
begin
thergn := newrgn;
with listrect do
setrect(therect, left - 1, top - 1, right + 16, bottom + 1);
with therect do
setrectrgn(thergn, left, top, right, bottom);
lupdate(thergn, list);
framerect(therect);
end;
procedure callupdate;
function digit2 (num: integer): str255;
var
temp: str255;
begin
numtostring(num, temp);
if num < 10 then
digit2 := concat('0', temp)
else
digit2 := temp;
end;
var
thecell: cell;
temp, scratch: str255;
begin
numtostring(current.hour, scratch);
if editing > ehour then
scratch := concat(scratch, ':', digit2(current.min));
if editing > emin then
scratch := concat(scratch, ':', digit2(current.sec));
thecell.h := 0;
thecell.v := pred(maxhist);
case state of
first:
scratch := concat(' ', scratch);
add:
scratch := concat('+', scratch);
sub:
scratch := concat('-', scratch);
eq:
scratch := concat('=', scratch);
end;
if current.negative then
scratch := concat(scratch, ' (-)');
lsetcell(pointer(succ(ord(@scratch))), length(scratch), thecell, list);
lscroll(0, maxhist, list);
end;
procedure currentdoneprep;
begin
with current do begin
if editing < esec then begin
sec := min;
min := hour;
hour := 0;
end;
if editing < emin then begin
sec := min;
min := hour;
hour := 0;
end;
editing := esec;
total := sec + min * 60 + longint(hour) * 3600;
end;
end;
procedure currentdone;
var
temp: integer;
begin
with current do begin
negative := total < 0;
total := abs(total);
sec := total mod 60;
min := (total div 60) mod 60;
hour := total div 3600;
end;
callupdate;
if state = sub then
memory := memory - current.total
else
memory := memory + current.total;
temp := laddrow(1, maxhist, list);
ldelrow(1, 0, list);
current.hour := 0;
current.min := 0;
current.sec := 0;
current.negative := false;
editing := ehour;
end;
procedure copy;
var
thecell: cell;
len: integer;
temp: array[0..127] of integer;
begin
thecell.h := 0;
thecell.v := pred(maxhist);
if zeroscrap = 0 then begin
len := 256;
lgetcell(@temp, len, thecell, list);
if putscrap(pred(len), 'TEXT', pointer(succ(ord(@temp)))) <> 0 then
sysbeep(1);
end
else
sysbeep(1);
end;
procedure number (num: integer);
begin
with current do
case editing of
ehour:
hour := (longint(hour) * 10 + num) mod 10000;
emin:
min := (min * 10 + num) mod 100;
esec:
sec := (sec * 10 + num) mod 100;
end;
callupdate;
end;
procedure colon;
begin
if editing < esec then
editing := succ(editing)
else
sysbeep(1);
callupdate;
end;
procedure paste;
type
data = packed array[0..32000] of char;
dataptr = ^data;
datahandle = ^dataptr;
var
err: boolean;
temp: datahandle;
i, len: integer;
offset: longint;
begin
err := false;
temp := datahandle(newhandle(0));
len := getscrap(handle(temp), 'TEXT', offset);
writeln(len);
if (len < 0) or (len > 20) then
sysbeep(1)
else begin
current.hour := 0;
current.min := 0;
current.sec := 0;
current.negative := false;
editing := ehour;
for i := 0 to pred(len) do begin
writeln(i, ',', temp^^[i]);
case temp^^[i] of
'0'..'9':
number(ord(temp^^[i]) - 48);
':', '.':
colon;
'-':
current.negative := true;
otherwise
err := true;
end;
end;
if temp <> nil then
disposhandle(handle(temp));
if err then
sysbeep(1);
callupdate;
end;
end;
procedure plus;
begin
currentdoneprep;
currentdone;
state := add;
callupdate;
end;
procedure minus;
begin
currentdoneprep;
currentdone;
state := sub;
callupdate;
end;
procedure equals;
begin
currentdoneprep;
currentdone;
state := eq;
current.total := memory;
editing := esec;
currentdone;
state := first;
callupdate;
memory := 0;
end;
procedure liststuff (event: eventrecord);
var
temp: boolean;
newdialog: dialogptr;
thergn: rgnhandle;
therect: rect;
begin
setport(thedialog);
globaltolocal(event.where);
if event.where.h > listrect.right then
temp := lclick(event.where, event.modifiers, list)
else begin
newdialog := getnewdialog(129, nil, pointer(-1));
thergn := newrgn;
with newdialog^.portrect do
setrect(therect, left - 1, top - 1, right + 16, bottom + 1);
with therect do
setrectrgn(thergn, left, top, right, bottom);
updtdialog(newdialog, thergn);
while stilldown do
;
repeat
until getnextevent(mdownmask, event);
disposdialog(newdialog);
end;
end;
{Main Program}
var
a: char;
i, j, k, item: integer;
r: rect;
where, cell, csize: point;
databounds: rect;
event: eventrecord;
temp: handle;
done, trapit: boolean;
begin
done := false;
state := first;
editing := ehour;
memory := 0;
current.hour := 0;
current.min := 0;
current.sec := 0;
current.negative := false;
thedialog := getnewdialog(128, @dstorage, pointer(-1));
getditem(thedialog, 18, item, temp, listrect);
setditem(thedialog, 18, item, @drawlist, listrect);
setrect(databounds, 0, 0, 1, maxhist);
csize.h := listrect.right - listrect.left - 15;
csize.v := 16;
listrect.right := listrect.right - 17;
list := lnew(listrect, databounds, csize, 0, thedialog, false, false, false, true);
callupdate;
lscroll(0, maxhist, list);
selectwindow(thedialog);
list^^.listflags := 0;
list^^.selflags := lonlyone;
repeat
initcursor;
repeat
systemtask;
until getnextevent(everyevent, event);
item := bitand(event.message, charcodemask);
trapit := false;
if ((event.what = keydown) or (event.what = autokey)) and (bitand(event.modifiers, cmdkey + optionkey) = 0) then
case item of
48..57:
begin
item := item - ord('0') + 4;
trapit := true;
end;
46, 58:
begin
item := 14;
trapit := true;
end;
43:
begin
item := 15;
trapit := true;
end;
45:
begin
item := 16;
trapit := true;
end;
3, 13, 61:
begin
item := 17;
trapit := true;
end;
otherwise
;
end;
if ((event.what = keydown) or (event.what = autokey)) and (bitand(event.modifiers, cmdkey + optionkey) = cmdkey) then
case item of
99:
copy;
118:
paste;
113:
done := true;
otherwise
;
end;
if not trapit then
if isdialogevent(event) then
if dialogselect(event, thedialog, item) then
trapit := true;
if trapit then
case item of {QCP0123456789:+-=L}
1:
done := true;
2:
copy;
3:
paste;
4..13:
number(item - 4);
14:
colon;
15:
plus;
16:
minus;
17:
equals;
18:
liststuff(event);
end;
until done;
disposdialog(thedialog);
end.